-- Siegel, Coveny HW#8

module Parsing (Parser (..), applyParser, item,
                returnP, seqP, chooseP, zeroP,
                sat, char, alphachar, many, many1, chainl1,
                test
               ) where

import Char

------------------------------------------------------------
-- Public types
------------------------------------------------------------

newtype Parser s a = Parser ([s] -> [(a,[s])])

------------------------------------------------------------
-- Public method declarations
------------------------------------------------------------

test :: IO ()

-- Unwraps a parser to apply it.
applyParser :: Parser s a -> [s] -> [(a,[s])]

-- Advances the parser a single item.
item :: Parser a a

-- Places a value in the parser output.
returnP :: a -> Parser b a

-- Applys two parsers in sequence.
seqP :: Parser s a -> (a -> Parser s b) -> Parser s b

-- Parse both and combine results.
chooseP :: Parser s a -> Parser s a -> Parser s a

-- Parse nothing.
zeroP :: Parser s a

-- Parses an item if it satisfies a predicate.
sat :: (a -> Bool) -> Parser a a

-- Parses a given character.
char :: Eq a => a -> Parser a a

-- Parses an item if it's an alpha character.
alphachar :: Parser Char Char

-- Apply a parser as many times as possible.
many :: Parser s a -> Parser s [a]

many1 :: Parser s a -> Parser s [a]

chainl1 :: Parser s a -> Parser s (a -> a -> a) -> Parser s a

------------------------------------------------------------
-- Public method definitions
------------------------------------------------------------

applyParser (Parser p) = p

item = Parser $ \cs -> case cs of
                           []     -> []
                           (c:cs) -> [(c,cs)]

returnP a = Parser (\cs -> [(a,cs)])

p `seqP` q  = Parser $
    \cs -> 
        let parsed = [applyParser (q a) cs' | (a,cs') <- applyParser p cs] in
        concat parsed

p `chooseP` q = Parser $ \cs -> applyParser p cs ++ applyParser q cs


zeroP = Parser (\cs -> [])

sat p = do c <- item
           if p c then return c else zeroP

char c = sat (c ==)

alphachar = sat isAlpha

many p = many1 p `chooseP` return []

many1 p = do {a <- p; as <- many p; return (a:as)}

p `chainl1` op =
 do {a <- p; rest a}
 where
   rest a = do {f <- op; b <- p; rest (f a b)}
            `chooseP` return a

-- Parser Monad instance declaration.
instance Monad (Parser s) where
   return = returnP
   (>>=)  = seqP

------------------------------------------------------------
-- Testing
------------------------------------------------------------

test = return ()


